This is an R Markdown Notebook. When you execute code within the notebook, the results appear beneath the code.

Try executing this chunk by clicking the Run button within the chunk or by placing your cursor inside it and pressing Ctrl+Shift+Enter. # Cellchat

source("./tianfengRwrappers.R")
library(CellChat)
ds2 <- readRDS("ds2.rds")
CA_dataset2 <- readRDS("CA_dataset2.rds")
# saveRDS(CA_dataset2,"CA_dataset2.rds")
umapplot(CA_dataset2)
Warning: Using `as.character()` on a quosure is deprecated as of rlang 0.3.0.
Please use `as_label()` or `as_name()` instead.
This warning is displayed once per session.

f("DLX5",EC_SMC)
umapplot(EC_SMC)

saveRDS(EC_SMC,"EC_SMC.rds")

CellChat

配体-受体+辅因子

computeAveExpr(cor, features = c("BMP2","BMP4","BMP6","BMPR1B","BMPR1A","BMPR2","ACVR2A"), type =  "truncatedMean", trim = 0.05)
                3        EC0         EC1         EC2 Fibroblast Fibromyocyte    Pericyte        SMC1       SMC2
BMP2   0.03150669 0.02623810 0.003702709 0.202131802 0.00000000   0.00000000 0.028212306 0.000000000 0.00000000
BMP4   0.00000000 0.02969807 0.064427142 0.535072542 0.14289603   0.05976591 0.000000000 0.008078115 0.02235959
BMP6   0.33885091 0.00000000 0.000000000 0.430656995 0.00000000   0.00000000 0.000000000 0.000000000 0.00000000
BMPR1B 0.00000000 0.00000000 0.000000000 0.000000000 0.08194540   0.00000000 0.000000000 0.008751292 0.07602259
BMPR1A 0.00000000 0.00000000 0.000000000 0.006539124 0.05175499   0.03366126 0.009241962 0.057668768 0.02832214
BMPR2  0.30466733 0.28211628 0.328085107 0.880202371 0.11521646   0.13015395 0.078799890 0.157702091 0.11248721
ACVR2A 0.00000000 0.00000000 0.000000000 0.000000000 0.01848392   0.00000000 0.000000000 0.000000000 0.00000000
write.csv(df.net,"./datatable/EC_SMC_cellchat_res.csv", row.names = F)

cellchat可视化

cor <- readRDS("EC_SMC_cellchat.rds")

# cor@idents <- plyr::revalue(cor@idents, c("Mod_SMC"="Fibroblast", "SMC_0"="SMC1","SMC_1"="Fibromyocyte",
#                    "SMC_2"="Pericyte","SMC_3"="SMC2"))

table(cor@idents)
groupSize <- as.numeric(table(cor@idents))
netVisual_circle(cor@net$weight, vertex.weight = groupSize, weight.scale = T, label.edge= F, title.name = "Interaction weights/strength")
netVisual_heatmap(cor, measure = "weight", signaling = NULL, color.heatmap = c("#f1f1f1", "#ff2121"))

#一次分析不同细胞亚群
mat <- cor@net$weight
for (i in 1:nrow(mat)) {
  mat2 <- matrix(0, nrow = nrow(mat), ncol = ncol(mat), dimnames = dimnames(mat))
  mat2[i, ] <- mat[i, ]
  netVisual_circle(mat2, vertex.weight = groupSize, weight.scale = T, edge.weight.max = max(mat), title.name = rownames(mat)[i])
}

# pheatmap(mat, display_numbers = FALSE, number_color ="black", cluster_rows = FALSE, 
         # cluster_cols = FALSE, color = colorRampPalette(c("#1E90FF", "white", "#ff2121"))(400), border_color = NA)

netVisual_aggregate(cor, signaling = pathways.show, layout = "circle")

netVisual_bubble(cor, sources.use = 4, targets.use = c(5:9), pairLR.use = LR_show, remove.isolate = F) #EC2 target
Comparing communications on a single object 

Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Ctrl+Alt+I.

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.

LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKVGhpcyBpcyBhbiBbUiBNYXJrZG93bl0oaHR0cDovL3JtYXJrZG93bi5yc3R1ZGlvLmNvbSkgTm90ZWJvb2suIFdoZW4geW91IGV4ZWN1dGUgY29kZSB3aXRoaW4gdGhlIG5vdGVib29rLCB0aGUgcmVzdWx0cyBhcHBlYXIgYmVuZWF0aCB0aGUgY29kZS4gCgpUcnkgZXhlY3V0aW5nIHRoaXMgY2h1bmsgYnkgY2xpY2tpbmcgdGhlICpSdW4qIGJ1dHRvbiB3aXRoaW4gdGhlIGNodW5rIG9yIGJ5IHBsYWNpbmcgeW91ciBjdXJzb3IgaW5zaWRlIGl0IGFuZCBwcmVzc2luZyAqQ3RybCtTaGlmdCtFbnRlciouIAojIENlbGxjaGF0CmBgYHtyfQpzb3VyY2UoIi4vdGlhbmZlbmdSd3JhcHBlcnMuUiIpCmxpYnJhcnkoQ2VsbENoYXQpCmBgYAoKCmBgYHtyfQpkczIgPC0gcmVhZFJEUygiZHMyLnJkcyIpCkNBX2RhdGFzZXQyIDwtIHJlYWRSRFMoIkNBX2RhdGFzZXQyLnJkcyIpCiMgc2F2ZVJEUyhDQV9kYXRhc2V0MiwiQ0FfZGF0YXNldDIucmRzIikKdW1hcHBsb3QoQ0FfZGF0YXNldDIpCmBgYAoKYGBge3J9CkVDX1NNQyA8LSBzdWJzZXQoQ0FfZGF0YXNldDIsIGlkZW50cyA9IGMoIkVuZG90aGVsaWFsIGNlbGwiKSkKCkVDX1NNQyA8LSBFQ19TTUMgJT4lIEZpbmROZWlnaGJvcnMoZGltcyA9IDE6MjApICU+JSBSdW5VTUFQKGRpbXMgPSAxOjIwKSAlPiUgCiAgRmluZENsdXN0ZXJzKHJlc29sdXRpb24gPSAwLjEpCgp1bWFwcGxvdChFQ19TTUMpCkVDX1NNQyA8LSBSZW5hbWVJZGVudHMoRUNfU01DLCcwJyA9ICdFQzAnLCcxJyA9ICdFQzEnLCcyJyA9ICdFQzInKQpEb3RwbG90KGMoIkJNUDEiLCJCTVAyIiksRUNfU01DKQoKRUNfU01DIDwtIG1lcmdlKEVDX1NNQywgZHMyKQpFQ19TTUMkQ2xhc3NpZmljYXRpb24yIDwtIElkZW50cyhFQ19TTUMpCkVDX1NNQyA8LSBFQ19TTUMgJT4lIFBlcmNlbnRhZ2VGZWF0dXJlU2V0KHBhdHRlcm4gPSAiXk1ULSIsIGNvbC5uYW1lID0gInBlcmNlbnQubXQiKSAlPiUKICBTQ1RyYW5zZm9ybSh2YXJzLnRvLnJlZ3Jlc3MgPSAicGVyY2VudC5tdCIsIHZlcmJvc2UgPSBGKSAlPiUgCiAgUnVuUENBKCkgJT4lIEZpbmROZWlnaGJvcnMoZGltcyA9IDE6MjApICU+JSAKICBSdW5VTUFQKGRpbXMgPSAxOjIwKQoKZigiQUNWUjJBIixFQ19TTUMpCnVtYXBwbG90KEVDX1NNQykKc2F2ZVJEUyhFQ19TTUMsIkVDX1NNQy5yZHMiKQpgYGAKCiMgQ2VsbENoYXQKIyMg6YWN5L2TLeWPl+S9kyvovoXlm6DlrZAKYGBge3J9CmNvciA8LSBjcmVhdGVDZWxsQ2hhdChFQ19TTUMpCmNlbGxjaGF0REIgPC0gQ2VsbENoYXREQi5odW1hbgoKc2hvd0RhdGFiYXNlQ2F0ZWdvcnkoY2VsbGNoYXREQikKI2NlbGxjaGF0REJfdXNlIDwtIHN1YnNldERCKGNlbGxjaGF0REIsIHNlYXJjaCA9ICJTZWNyZXRlZCBTaWduYWxpbmciKSAgI+S9v+eUqOeJueWumuexu+Wei+eahOmFjeS9k+WPl+S9k+ebuOS6kuWFs+ezuwoKI+aMh+WumuWIhuaekOS9v+eUqOeahGRhdGFiYXNlCmNvckBEQiA8LSBjZWxsY2hhdERCCgoj6IqC55yB6K6h566X5oiQ5pysCmNvciA8LSBzdWJzZXREYXRhKGNvcikKY29yIDwtIGlkZW50aWZ5T3ZlckV4cHJlc3NlZEdlbmVzKGNvcikKY29yIDwtIGlkZW50aWZ5T3ZlckV4cHJlc3NlZEludGVyYWN0aW9ucyhjb3IpCiPkvb/nlKjom4vnmb3otKjkupLkvZznvZHnu5zvvIzmoLnmja7ln7rlm6Dpl7Tnm7jkupLlhbPns7vooaXlhYXooajovr7ph48KIyBjb3IgPC0gcHJvamVjdERhdGEoY29yLCBQUEkuaHVtYW4pCgpjb21wdXRlQXZlRXhwcihjb3IsIGZlYXR1cmVzID0gYygiQk1QMiIsIkJNUDQiLCJCTVA2IiwiQk1QUjFCIiwiQk1QUjFBIiwiQk1QUjIiLCJBQ1ZSMkEiKSwgdHlwZSA9ICAidHJ1bmNhdGVkTWVhbiIsIHRyaW0gPSAwLjA1KQoj5o6o5pat57uG6IOe6Ze06YCa5L+h572R57uc77yM5LiN6KaB5L2/55So5bm26KGM6K6h566X77yBCmNvciA8LSBjb21wdXRlQ29tbXVuUHJvYihjb3IsIHR5cGUgPSAidHJ1bmNhdGVkTWVhbiIsIHRyaW0gPSAwLjA1KQoj6Iul57uG6IOe576k5Lit5Y+q5pyJ5bCR5pWw57uG6IOe5Ye6546w6IGU57O7KDwxMOS4qinvvIzliJnov4fmu6TmjonlroPku6wKY29yIDwtIGZpbHRlckNvbW11bmljYXRpb24oY29yLCBtaW4uY2VsbHMgPSAxMCkKCiPmj5Dlj5booajovr7nvZHnu5znn6npmLUKIyBkZi5uZXQgPC0gc3Vic2V0Q29tbXVuaWNhdGlvbihjb3IpCmRmLm5ldCA8LSBzdWJzZXRDb21tdW5pY2F0aW9uKGNvcixzaWduYWxpbmcgPSBjKCJCTVAiKSkgI+aMh+WumuWIhuaekOeahOmAmui3r+WSjOe7huiDnuexu+e+pAoKI+aOqOaWreS/oeWPt+mAmui3rwpjb3IgPC0gY29tcHV0ZUNvbW11blByb2JQYXRod2F5KGNvcikKCiPlkIjlubbpgJrkv6HnvZHnu5zmlbDmja4KY29yIDwtIGFnZ3JlZ2F0ZU5ldChjb3IpCnNhdmVSRFMoY29yLCJFQ19TTUNfY2VsbGNoYXQucmRzIikKYGBgCgpgYGB7cn0Kd3JpdGUuY3N2KGRmLm5ldCwiLi9kYXRhdGFibGUvRUNfU01DX2NlbGxjaGF0X3Jlcy5jc3YiLCByb3cubmFtZXMgPSBGKQpgYGAKCgoKIyMgY2VsbGNoYXTlj6/op4bljJYKYGBge3IsZmlnLmhlaWdodD02LGZpZy53aWR0aD02fQpjb3IgPC0gcmVhZFJEUygiRUNfU01DX2NlbGxjaGF0LnJkcyIpCgojIGNvckBpZGVudHMgPC0gcGx5cjo6cmV2YWx1ZShjb3JAaWRlbnRzLCBjKCJNb2RfU01DIj0iRmlicm9ibGFzdCIsICJTTUNfMCI9IlNNQzEiLCJTTUNfMSI9IkZpYnJvbXlvY3l0ZSIsCiMgICAgICAgICAgICAgICAgICAgICJTTUNfMiI9IlBlcmljeXRlIiwiU01DXzMiPSJTTUMyIikpCgp0YWJsZShjb3JAaWRlbnRzKQpncm91cFNpemUgPC0gYXMubnVtZXJpYyh0YWJsZShjb3JAaWRlbnRzKSkKbmV0VmlzdWFsX2NpcmNsZShjb3JAbmV0JHdlaWdodCwgdmVydGV4LndlaWdodCA9IGdyb3VwU2l6ZSwgd2VpZ2h0LnNjYWxlID0gVCwgbGFiZWwuZWRnZT0gRiwgdGl0bGUubmFtZSA9ICJJbnRlcmFjdGlvbiB3ZWlnaHRzL3N0cmVuZ3RoIikKbmV0VmlzdWFsX2hlYXRtYXAoY29yLCBtZWFzdXJlID0gIndlaWdodCIsIHNpZ25hbGluZyA9IE5VTEwsIGNvbG9yLmhlYXRtYXAgPSBjKCIjZjFmMWYxIiwgIiNmZjIxMjEiKSkKCiPkuIDmrKHliIbmnpDkuI3lkIznu4bog57kuprnvqQKbWF0IDwtIGNvckBuZXQkd2VpZ2h0CmZvciAoaSBpbiAxOm5yb3cobWF0KSkgewogIG1hdDIgPC0gbWF0cml4KDAsIG5yb3cgPSBucm93KG1hdCksIG5jb2wgPSBuY29sKG1hdCksIGRpbW5hbWVzID0gZGltbmFtZXMobWF0KSkKICBtYXQyW2ksIF0gPC0gbWF0W2ksIF0KICBuZXRWaXN1YWxfY2lyY2xlKG1hdDIsIHZlcnRleC53ZWlnaHQgPSBncm91cFNpemUsIHdlaWdodC5zY2FsZSA9IFQsIGVkZ2Uud2VpZ2h0Lm1heCA9IG1heChtYXQpLCB0aXRsZS5uYW1lID0gcm93bmFtZXMobWF0KVtpXSkKfQoKIyBwaGVhdG1hcChtYXQsIGRpc3BsYXlfbnVtYmVycyA9IEZBTFNFLCBudW1iZXJfY29sb3IgPSJibGFjayIsIGNsdXN0ZXJfcm93cyA9IEZBTFNFLCAKICAgICAgICAgIyBjbHVzdGVyX2NvbHMgPSBGQUxTRSwgY29sb3IgPSBjb2xvclJhbXBQYWxldHRlKGMoIiMxRTkwRkYiLCAid2hpdGUiLCAiI2ZmMjEyMSIpKSg0MDApLCBib3JkZXJfY29sb3IgPSBOQSkKCmBgYAoKYGBge3IsZmlnLmhlaWdodD02LGZpZy53aWR0aD02fQpuZXRWaXN1YWxfY2hvcmRfZ2VuZShjb3IsIHNvdXJjZXMudXNlID0gYyg0KSwgdGFyZ2V0cy51c2UgPSBjKDI6OSksIGxhYi5jZXggPSAwLjUsIGxlZ2VuZC5wb3MueSA9IDMwLHRocmVzaCA9IDAuMDAxKQoKbmV0VmlzdWFsX2Nob3JkX2dlbmUoY29yLCBzb3VyY2VzLnVzZSA9IGMoNCksIHRhcmdldHMudXNlID0gYyg5KSwgbGFiLmNleCA9IDAuNSwgbGVnZW5kLnBvcy55ID0gMzAsIHRocmVzaCA9IDAuMDAxKQpgYGAKCgpgYGB7cixmaWcuaGVpZ2h0PTYsZmlnLndpZHRoPTZ9CiPmjIflrppwYXRod2F5CnBhdGh3YXlzLnNob3cgPC0gYygiQk1QIikgCgpuZXRWaXN1YWxfYWdncmVnYXRlKGNvciwgc2lnbmFsaW5nID0gcGF0aHdheXMuc2hvdywgbGF5b3V0ID0gImNpcmNsZSIpCiMgbmV0VmlzdWFsX2FnZ3JlZ2F0ZShjb3IsIHNpZ25hbGluZyA9IHBhdGh3YXlzLnNob3csIGxheW91dCA9ICJjaG9yZCIpCgojIEhlYXRtYXAKbmV0VmlzdWFsX2hlYXRtYXAoY29yLCBzaWduYWxpbmcgPSBwYXRod2F5cy5zaG93LCBjb2xvci5oZWF0bWFwID0gYygiI2YxZjFmMSIsICIjZmYyMTIxIikpCmBgYAoKCmBgYHtyLGZpZy5oZWlnaHQ9NCxmaWcud2lkdGg9NH0KI+WPr+inhuWMluWNleS4qumFjeS9k+WPl+S9k+WvueeahOW9seWTjQpuZXRBbmFseXNpc19jb250cmlidXRpb24oY29yLCBzaWduYWxpbmcgPSBwYXRod2F5cy5zaG93KQpwYWlyTFIuQk1QIDwtIGV4dHJhY3RFbnJpY2hlZExSKGNvciwgc2lnbmFsaW5nID0gcGF0aHdheXMuc2hvdywgZ2VuZUxSLnJldHVybiA9IEZBTFNFLHRocmVzaCA9IDAuMDAxKQpMUi5zaG93IDwtIHBhaXJMUi5CTVBbOCxdICMgc2hvdyBvbmUgbGlnYW5kLXJlY2VwdG9yIHBhaXIgQk1QMl9CTVBSMUIKbmV0VmlzdWFsX2luZGl2aWR1YWwoY29yLCBzaWduYWxpbmcgPSBwYXRod2F5cy5zaG93LCBsYXlvdXQgPSAiaGllcmFyY2h5IiwgIHBhaXJMUi51c2UgPSBMUi5zaG93LCB2ZXJ0ZXgucmVjZWl2ZXIgPSBjKDU6OSkpCm5ldFZpc3VhbF9pbmRpdmlkdWFsKGNvciwgc2lnbmFsaW5nID0gcGF0aHdheXMuc2hvdywgcGFpckxSLnVzZSA9IExSLnNob3csIGxheW91dCA9ICJjaXJjbGUiKQojIG5ldFZpc3VhbF9pbmRpdmlkdWFsKGNvciwgc2lnbmFsaW5nID0gcGF0aHdheXMuc2hvdywgcGFpckxSLnVzZSA9IExSLnNob3csIGxheW91dCA9ICJjaG9yZCIpCgpMUi5zaG93IDwtIHBhaXJMUi5CTVBbMixdICMgc2hvdyBvbmUgbGlnYW5kLXJlY2VwdG9yIHBhaXIgQk1QMl9CTVBSMUIKbmV0VmlzdWFsX2luZGl2aWR1YWwoY29yLCBzaWduYWxpbmcgPSBwYXRod2F5cy5zaG93LCBsYXlvdXQgPSAiaGllcmFyY2h5IiwgIHBhaXJMUi51c2UgPSBMUi5zaG93LCB2ZXJ0ZXgucmVjZWl2ZXIgPSBjKDU6OSkpCgojIEhpZXJhcmNoeSBwbG90Cm5ldFZpc3VhbF9pbmRpdmlkdWFsKGNvciwgc2lnbmFsaW5nID0gcGF0aHdheXMuc2hvdyxsYXlvdXQgPSAiaGllcmFyY2h5IiwgIHBhaXJMUi51c2UgPSBMUi5zaG93LCB2ZXJ0ZXgucmVjZWl2ZXIgPSB2ZXJ0ZXgucmVjZWl2ZXIpCm5ldFZpc3VhbF9pbmRpdmlkdWFsKGNvciwgc2lnbmFsaW5nID0gcGF0aHdheXMuc2hvdywgcGFpckxSLnVzZSA9IExSLnNob3csIGxheW91dCA9ICJjaXJjbGUiKQpuZXRWaXN1YWxfaW5kaXZpZHVhbChjb3IsIHNpZ25hbGluZyA9IHBhdGh3YXlzLnNob3csIHBhaXJMUi51c2UgPSBMUi5zaG93LCBsYXlvdXQgPSAiY2hvcmQiKQoKTFJfc2hvdyA8LSBkYXRhLmZyYW1lKGludGVyYWN0aW9uX25hbWUgPSBwYWlyTFIuQk1QW2MoMiw0LDYsOCksXSkgI+WxleekukJNUOS9nOS4uumFjeS9kwoKbmV0VmlzdWFsX2J1YmJsZShjb3IsIHNvdXJjZXMudXNlID0gNCwgdGFyZ2V0cy51c2UgPSBjKDU6OSksIHBhaXJMUi51c2UgPSBMUl9zaG93LCByZW1vdmUuaXNvbGF0ZSA9IEYsIHJldHVybi5kYXRhID0gVCkgI0VDMiB0YXJnZXQKCmBgYApBZGQgYSBuZXcgY2h1bmsgYnkgY2xpY2tpbmcgdGhlICpJbnNlcnQgQ2h1bmsqIGJ1dHRvbiBvbiB0aGUgdG9vbGJhciBvciBieSBwcmVzc2luZyAqQ3RybCtBbHQrSSouCgpXaGVuIHlvdSBzYXZlIHRoZSBub3RlYm9vaywgYW4gSFRNTCBmaWxlIGNvbnRhaW5pbmcgdGhlIGNvZGUgYW5kIG91dHB1dCB3aWxsIGJlIHNhdmVkIGFsb25nc2lkZSBpdCAoY2xpY2sgdGhlICpQcmV2aWV3KiBidXR0b24gb3IgcHJlc3MgKkN0cmwrU2hpZnQrSyogdG8gcHJldmlldyB0aGUgSFRNTCBmaWxlKS4KClRoZSBwcmV2aWV3IHNob3dzIHlvdSBhIHJlbmRlcmVkIEhUTUwgY29weSBvZiB0aGUgY29udGVudHMgb2YgdGhlIGVkaXRvci4gQ29uc2VxdWVudGx5LCB1bmxpa2UgKktuaXQqLCAqUHJldmlldyogZG9lcyBub3QgcnVuIGFueSBSIGNvZGUgY2h1bmtzLiBJbnN0ZWFkLCB0aGUgb3V0cHV0IG9mIHRoZSBjaHVuayB3aGVuIGl0IHdhcyBsYXN0IHJ1biBpbiB0aGUgZWRpdG9yIGlzIGRpc3BsYXllZC4K